home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / borland / svgabg52.zip / VGADEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1993-09-05  |  50KB  |  1,791 lines
  1. program BGIDemo;
  2. {
  3.  
  4.   Turbo Pascal Borland Graphics Interface (BGI) demonstration
  5.   program. This program shows how to use many features of
  6.   the Graph unit.
  7.  
  8.   Copyright (c) 1985-89 by Borland International, Inc.
  9.  
  10. }
  11.  
  12. uses
  13.   Crt, Dos, Graph;
  14.  
  15.  
  16. const
  17.   { The five fonts available }
  18.   Fonts : array[0..4] of string[13] =
  19.   ('DefaultFont', 'TriplexFont', 'SmallFont', 'SansSerifFont', 'GothicFont');
  20.  
  21.   { The five predefined line styles supported }
  22.   LineStyles : array[0..4] of string[9] =
  23.   ('SolidLn', 'DottedLn', 'CenterLn', 'DashedLn', 'UserBitLn');
  24.  
  25.   { The twelve predefined fill styles supported }
  26.   FillStyles : array[0..11] of string[14] =
  27.   ('EmptyFill', 'SolidFill', 'LineFill', 'LtSlashFill', 'SlashFill',
  28.    'BkSlashFill', 'LtBkSlashFill', 'HatchFill', 'XHatchFill',
  29.    'InterleaveFill', 'WideDotFill', 'CloseDotFill');
  30.  
  31.   { The two text directions available }
  32.   TextDirect : array[0..1] of string[8] = ('HorizDir', 'VertDir');
  33.  
  34.   { The Horizontal text justifications available }
  35.   HorizJust  : array[0..2] of string[10] = ('LeftText', 'CenterText', 'RightText');
  36.  
  37.   { The vertical text justifications available }
  38.   VertJust   : array[0..2] of string[10] = ('BottomText', 'CenterText', 'TopText');
  39.  
  40. var
  41.   GraphDriver : integer;  { The Graphics device driver }
  42.   GraphMode   : integer;  { The Graphics mode value }
  43.   MaxX, MaxY  : word;     { The maximum resolution of the screen }
  44.   ErrorCode   : integer;  { Reports any graphics errors }
  45.   MaxColor    : word;     { The maximum color value available }
  46.   OldExitProc : Pointer;  { Saves exit procedure address }
  47.  
  48. function RealDrawColor(Color : Word) : Word;
  49. begin
  50.   if (GetMaxColor > 32768) then
  51.     SetRgbPalette(1024,(Color SHR 11) AND 31,(Color SHR 5)AND 63,Color AND 31)
  52.   else if (GetMaxColor > 256) then
  53.     SetRgbPalette(1024,(Color SHR 10) AND 31,(Color SHR 5)AND 31,Color AND 31);
  54.   RealDrawColor := Color;
  55. end;
  56.  
  57. function RealFillColor(Color : Word) : Word;
  58. begin
  59.   if (GetMaxColor > 32768) then
  60.     SetRgbPalette(1025,(Color SHR 11) AND 31,(Color SHR 5)AND 63,Color AND 31)
  61.   else if (GetMaxColor > 256) then
  62.     SetRgbPalette(1025,(Color SHR 10) AND 31,(Color SHR 5)AND 31,Color AND 31);
  63.   RealFillColor := Color;
  64. end;
  65.  
  66. function RealColor(Color : Word) : Word;
  67. begin
  68.   if (GetMaxColor > 32768) then
  69.     SetRgbPalette(1026,(Color SHR 11) AND 31,(Color SHR 5)AND 63,Color AND 31)
  70.   else if (GetMaxColor > 256) then
  71.     SetRgbPalette(1026,(Color SHR 10) AND 31,(Color SHR 5)AND 31,Color AND 31);
  72.   RealColor := Color;
  73. end;
  74.  
  75. function WhitePixel : Word;
  76. var Clr : Word;
  77. begin
  78.   if (GetMaxColor > 32768) then
  79.     Clr := 65535
  80.   else if (GetMaxColor > 256) then
  81.     Clr := 32767
  82.   else
  83.     Clr := 15;
  84.   WhitePixel := Clr;
  85. end;
  86.  
  87. function BluePixel : Word;
  88. var Clr : Word;
  89. begin
  90.   if (GetMaxColor > 256) then
  91.     Clr := 31
  92.   else
  93.     Clr := 1;
  94.   BluePixel := Clr;
  95. end;
  96.  
  97. function GreenPixel : Word;
  98. var Clr : Word;
  99. begin
  100.   if (GetMaxColor > 32768) then
  101.     Clr := 63 SHL 5
  102.   else if (GetMaxColor > 256) then
  103.     Clr := 31 SHL 5
  104.   else
  105.     Clr := 2;
  106.   GreenPixel := Clr;
  107. end;
  108.  
  109.  
  110. {$F+}
  111. procedure MyExitProc;
  112. begin
  113.   ExitProc := OldExitProc; { Restore exit procedure address }
  114.   CloseGraph;              { Shut down the graphics system }
  115. end; { MyExitProc }
  116. {$F-}
  117.  
  118. {$F+}
  119. function DetectVGA256 : integer;
  120. { Detects VGA or MCGA video cards }
  121. var
  122.   DetectedDriver : integer;
  123.   SuggestedMode  : integer;
  124. begin
  125.   DetectGraph(DetectedDriver, SuggestedMode);
  126.   if (DetectedDriver = VGA) or (DetectedDriver = MCGA) then
  127.   begin
  128.     Writeln('Which video mode would you like to use?');
  129.     Writeln('  0) 320x200x256');
  130.     Writeln('  1) 640x400x256');
  131.     Writeln('  2) 640x480x256');
  132.     Writeln('  3) 800x600x256');
  133.     Writeln('  4) 1024x768x256');
  134.     Writeln('  5) 640x350x256');
  135.     Writeln('  6) 1280x1024x256');
  136.     Write('> ');
  137.     Readln(SuggestedMode);
  138.     DetectVGA256 := SuggestedMode;
  139.   end
  140.   else
  141.     DetectVGA256 := grError; { Couldn't detect hardware }
  142. end; { DetectVGA256 }
  143. {$F-}
  144.  
  145. {$F+}
  146. function DetectVGA32k : integer;
  147. { Detects VGA or MCGA video cards }
  148. var
  149.   DetectedDriver : integer;
  150.   SuggestedMode  : integer;
  151. begin
  152.   DetectGraph(DetectedDriver, SuggestedMode);
  153.   if (DetectedDriver = VGA) or (DetectedDriver = MCGA) then
  154.   begin
  155.     Writeln('Which video mode would you like to use?');
  156.     Writeln('  0) 320x200x32k');
  157.     Writeln('  1) 640x350x32k');
  158.     Writeln('  2) 640x400x32k');
  159.     Writeln('  3) 640x480x32k');
  160.     Writeln('  4) 800x600x32k');
  161.     Writeln('  5) 1024x768x32k');
  162.     Writeln('  6) 1280x1024x32k');
  163.     Write('> ');
  164.     Readln(SuggestedMode);
  165.     DetectVGA32k := SuggestedMode;
  166.   end
  167.   else
  168.     DetectVGA32k := grError; { Couldn't detect hardware }
  169. end; { DetectVGA32k }
  170. {$F-}
  171.  
  172. {$F+}
  173. function DetectVGA64k : integer;
  174. { Detects VGA or MCGA video cards }
  175. var
  176.   DetectedDriver : integer;
  177.   SuggestedMode  : integer;
  178. begin
  179.   DetectGraph(DetectedDriver, SuggestedMode);
  180.   if (DetectedDriver = VGA) or (DetectedDriver = MCGA) then
  181.   begin
  182.     Writeln('Which video mode would you like to use?');
  183.     Writeln('  0) 320x200x64k');
  184.     Writeln('  1) 640x350x64k');
  185.     Writeln('  2) 640x400x64k');
  186.     Writeln('  3) 640x480x64k');
  187.     Writeln('  4) 800x600x64k');
  188.     Writeln('  5) 1024x768x64k');
  189.     Writeln('  6) 1280x1024x64k');
  190.     Write('> ');
  191.     Readln(SuggestedMode);
  192.     DetectVGA64k := SuggestedMode;
  193.   end
  194.   else
  195.     DetectVGA64k := grError; { Couldn't detect hardware }
  196. end; { DetectVGA32k }
  197. {$F-}
  198.  
  199.  
  200. {$F+}
  201. function DetectTwk256 : integer;
  202. { Detects VGA or MCGA video cards }
  203. var
  204.   DetectedDriver : integer;
  205.   SuggestedMode  : integer;
  206. begin
  207.   DetectGraph(DetectedDriver, SuggestedMode);
  208.   if (DetectedDriver = VGA) or (DetectedDriver = MCGA) then
  209.   begin
  210.     Writeln('Which video mode would you like to use?');
  211.     Writeln('  0) 320x400x256');
  212.     Writeln('  1) 320x480x256');
  213.     Writeln('  2) 360x480x256');
  214.     Writeln('  3) 376x564x256');
  215.     Writeln('  4) 400x564x256');
  216.     Writeln('  5) 400x600x256');
  217.     Writeln('  6) 320x240x256');
  218.     Write('> ');
  219.     Readln(SuggestedMode);
  220.     DetectTwk256 := SuggestedMode;
  221.   end
  222.   else
  223.     DetectTwk256 := grError; { Couldn't detect hardware }
  224. end; { DetectVGA256 }
  225. {$F-}
  226.  
  227. {$F+}
  228. function DetectVGA16 : integer;
  229. { Detects VGA or MCGA video cards }
  230. var
  231.   DetectedDriver : integer;
  232.   SuggestedMode  : integer;
  233. begin
  234.   DetectGraph(DetectedDriver, SuggestedMode);
  235.   if (DetectedDriver = EGA) or (DetectedDriver = VGA) then
  236.   begin
  237.     Writeln('Which video mode would you like to use?');
  238.     Writeln('  0) 320x200x16');
  239.     Writeln('  1) 640x200x16');
  240.     Writeln('  2) 640x350x16');
  241.     Writeln('  3) 640x480x16');
  242.     Writeln('  4) 800x600x16');
  243.     Writeln('  5) 1024x768x16');
  244.     Writeln('  6) 1280x1024x16');
  245.     Write('> ');
  246.     Readln(SuggestedMode);
  247.     DetectVGA16 := SuggestedMode;
  248.   end
  249.   else
  250.     DetectVGA16 := grError; { Couldn't detect hardware }
  251. end; { DetectVGA256 }
  252. {$F-}
  253.  
  254. {$F+}
  255. function DetectTwk16 : integer;
  256. { Detects VGA or MCGA video cards }
  257. var
  258.   DetectedDriver : integer;
  259.   SuggestedMode  : integer;
  260. begin
  261.   DetectGraph(DetectedDriver, SuggestedMode);
  262.   if (DetectedDriver = VGA) then
  263.   begin
  264.     Writeln('Which video mode would you like to use?');
  265.     Writeln('  0) 704x528x16');
  266.     Writeln('  1) 720x540x16');
  267.     Writeln('  2) 736x552x16');
  268.     Writeln('  3) 752x564x16');
  269.     Writeln('  4) 768x576x16');
  270.     Writeln('  5) 784x588x16');
  271.     Writeln('  6) 800x600x16');
  272.     Write('> ');
  273.     Readln(SuggestedMode);
  274.     DetectTwk16 := SuggestedMode;
  275.   end
  276.   else
  277.     DetectTwk16 := grError; { Couldn't detect hardware }
  278. end; { DetectVGA256 }
  279. {$F-}
  280.  
  281. {$F+}
  282. function DetectText : integer;
  283. begin
  284.   DetectText := 0;
  285. end;
  286. {$F-}
  287.  
  288. {$F+}
  289. function DetectS3 : integer;
  290. { Detects VGA or MCGA video cards }
  291. var
  292.   DetectedDriver : integer;
  293.   SuggestedMode  : integer;
  294. begin
  295.   DetectGraph(DetectedDriver, SuggestedMode);
  296.   if (DetectedDriver = VGA) then
  297.   begin
  298.     Writeln('Which video mode would you like to use?');
  299.     Writeln('  0) 640x480x